1 Podsumowanie

Wstępna analiza surowych danych pokazała bardzo dużą ilość brakujących danych (powyżej 80%). Większość wierszy zawierała wyniki co najwyżej kilku z kilkudziesięcie (powyżej 70) atrybutów. Podczas czyszczenia danych usunięto kilka atrybutów nieposiadających żadnych wartości. W innych kolumnach częściowo uzupełniono brakujące wartości wykorzystując interpolację lub stałą wartość. W zbiorze wynikowym pozostawiono ok 8% wartości nieokreślonych. W wyczyszczonym zbiorze danych znajduje się 5606 wierszy, które zawierają wyniki badań 360 pacjentów. Wśród pacjentów było 212 mężczyzn oraz 149 kobiet. Przeżyło 166 pacjentów (30.9% chorych kobiet i 56.6% chorych mężczyzn). Dane zbierane były w okresie 10.01.2020 - 04.03.2020. Atrybuty opisują wyniki badań krwi pacjentów. Między większością atrybutów zachodzi korelacja (negatywna lub pozytywna). Udało się znaleźć model klasyfikatora, który dla podanych danych testowych osiąga potrafi przewidzieć, czy pacjent przeżyje z dokładnością wynoszącą 95%.

2 Przygotowanie srodowiska i danych

2.1 Import bibliotek

library(xlsx)
library(DT)
library(knitr)
library(dplyr)
library(tidyr)
library(janitor)
library(imputeTS)
library(lares)
library(plotly)
library(caret)
library(qgraph)
library(ggforce)

2.2 Wczytanie danych

raw_data <- read.xlsx(filename, 1)
raw_data <- as_tibble(raw_data)
dim(raw_data)
## [1] 6120   81

2.3 Wstepna analiza surowych danych

Pierwsze 30 wierszy ze zbioru:

*** Podstawowe statystyki dla całego zbioru:

##  Dane bedace wartoscami brakujacymi (NA):  88 % 
##  Wartosc minimalna:  -1 
##  Wartosc maksymalna:  50000 
##  Liczba pacjentów:  375 
##  Okres zbierania danych:  2020-01-10 15:52:19  -  2020-03-04 16:21:51

Podstawowe statystyki dla poszczególnych atrybutów:

2.4 Transformacja danych

2.4.1 Wstepne czyszczenie danych

Wstępne czyszczenie danych:

  • zamiana wartości -1 na NA
  • uzupełnienie kolumny PATIENT_ID
  • usunięcie pustych wierszy i kolumn
  • zmiana nazw kolumn
  • przypisanie czytelnych wartości w kolumnach outcome (wynik) i gender (płeć)
#replace -1 with NA
raw_data[raw_data==-1]<-NA

#filling PATIENT_ID
id_filled <- raw_data %>% fill(PATIENT_ID)

#remove rows where all variables are empty
vars <- colnames(id_filled)[-(1:7)]
no_empty_rows<- id_filled[rowSums(is.na(id_filled[vars])) != length(vars), ]
no_empty_cols <- no_empty_rows[colSums(!is.na(no_empty_rows)) > 0]

#renaming columns
colnames_cleaned <- no_empty_cols %>% clean_names()

colnames_cleaned$outcome=factor(colnames_cleaned$outcome, labels = make.names(c("death", "release")))
colnames_cleaned$gender=factor(colnames_cleaned$gender, labels = make.names(c("M", "F")))

2.4.2 Brakujace wartosci

Eliminacja brakujących wartości na poziomie pacjenta obejmowała:

  • interpolację, jeżeli w kolumnie były co najmniej dwie wartości niebędące NA
  • stała wartość, jezeli w kolumnie byla dokladnie jedna wartość niebędąca NA

Jeżeli żadne z powyższych rozwiązań nie było możliwe, wartości NA zostawiono.

clean_NA<-function(column){
  not_NA_count<-sum(!is.na(column))
  if (not_NA_count>=2){ #interpolate
    column <- na_interpolation(column, option = "linear")
    column
  }

  else if (not_NA_count==1){ #constant value
    val <- first(na.omit(column))
    column[is.na(column)] <- val
    column
  }#default: leave NA values
  column
}

#for each patient:
# for each column:
#  clean_NA
cleaned<- colnames_cleaned%>% group_by(patient_id) %>% mutate_each(list(clean_NA))

#extract columns with attributes only
attributes<-cleaned[-(1:7)]

3 Wyczyszczone dane - podsumowanie

3.1 Przeglad danych

Podsumowanie zbioru:

Parametr Wartosc
Liczba pacjentów 360
Liczba pomiarów 5606
Srednia liczba pomiarów na pacjenta 16
Liczba kolumn 80
Liczba zmiennych 73
Procent brakujacych wartosci 6

Wykresy prezentujące podział danych ze względu na płeć i rezultat:

Wykres obrazujący czasy przyjęcia i wypisania lub śmierci z wyróżnieniem płci:

***

Tabela pokazująca 30 pierwszych rekordów po wyczyszczeniu danych:

3.2 Analiza wartosci atrybutow

Podsumowanie każdego z atrybutów:

***

Histogramy przedstawiajace rozkład atrybutów:

3.3 Korelacja miedzy atrybutami

Poniższy graf przedstawia korelację pomiędzy parami atrybutów. Grubość lini łączącej dwa atrybuty jest zależna od współczynnika korelacji, natomiast kolor oznacza korelację dodatnią (kolor zielony) lub ujemną (kolor czerwony)

Wykres przedstawiający 20 par atrybutów z największą korelacją:

3.4 Zmiana atrybutów w czasie

Poniższy wykres przedstawia wartości atrybutów hemoglobin (poziom hemoglobiny we krwi) oraz glucose (poziom glukozy we krwi) dla poszczególnych dni pobytu pacjenta w szpitalu. Celem wykresu jest próba pokazania zmiany tych atrybutów w czasie hospitalizacji pacjentów.

4 Klasyfikator

Przygotowanie danych do klasyfikacji:

  • redukcja danych opisujacych pojedynczego pacjenta do jednego wiersza, z zachowaniem najwcześniejszych wartosci atrybutów (żeby jak najszybciej przewidziec śmierć pacjenta)
  • usunięcie kolumn niebędących atrybutami
  • podział na zbiory uczący i testujący
  • usunięcie wierszy i kolumn, w ktorych wartości brakujące to wiecej niż 20% danych
  • przypisanie wartości średniej atrybutów do pozostałych wartości brakujących

Budowa klasyfikatora:

tune_grid <- expand.grid(mtry = 10:30)
gridCtrl <- trainControl(
    method = "repeatedcv",
    summaryFunction = twoClassSummary,
    classProbs = TRUE,
    number = 2,
    repeats = 10)
fitTune <- train(outcome ~ .,
             data = training,
             method = "rf",
             metric = "ROC",
             preProc = c("center", "scale"),
             trControl = gridCtrl,
             tuneGrid = tune_grid,
             ntree = 30)
prediction <- predict(fitTune,
                         newdata = testing)

Podsumowanie rezultatu:

ggplot(fitTune) + theme_bw()

confusionMatrix(data = prediction, 
                testing$outcome)
## Confusion Matrix and Statistics
## 
##           Reference
## Prediction death release
##    death      47       3
##    release     1      37
##                                              
##                Accuracy : 0.9545             
##                  95% CI : (0.8877, 0.9875)   
##     No Information Rate : 0.5455             
##     P-Value [Acc > NIR] : <0.0000000000000002
##                                              
##                   Kappa : 0.9079             
##                                              
##  Mcnemar's Test P-Value : 0.6171             
##                                              
##             Sensitivity : 0.9792             
##             Specificity : 0.9250             
##          Pos Pred Value : 0.9400             
##          Neg Pred Value : 0.9737             
##              Prevalence : 0.5455             
##          Detection Rate : 0.5341             
##    Detection Prevalence : 0.5682             
##       Balanced Accuracy : 0.9521             
##                                              
##        'Positive' Class : death              
##

Dokładność predykcji wynosi 93% i z pewnością nie jest to najlepszy możliwy wynik. Warto jednak zwrócić uwagę na wartości otrzymane w macierzy pomyłek: liczba uzyskanych wartości False Negative (model przewidział, że pacjent przeżyje, a w rzeczywistości on umiera) jest równa zero. W rozważanym przypadku lepiej zakładać, że pacjent jest w stanie gorszym niż jest w rzeczywistości, niż odwrotnie.